main_analysis_withoutoutlires

General analysis plan

Our analysis will evaluate the pilot outcomes for the Perceived Social Categorization Study. Participants rated the same set of 85 photos for perceived “Jewishness” and “Arabness.” Our objective is to pinpoint images where the average ratings across these two dimensions do not significantly diverge. This nuanced approach enables us to select images that best represent a balanced perception, laying a robust foundation for our main study and ensuring the integrity and relevance of our visual stimuli.

Data importation and initial preparation

helper function’s

standardize column names

Utilize the provided helper function colnames_to_underscores to standardize column names by replacing spaces and special characters with underscores.

Code
colnames_to_underscores <- function(data = NULL) {
  dat <- data
  names(dat) <- stringr::str_replace_all(names(dat), pattern = " ", replacement = "_")
  return(dat)
  }

get_summary_stats_function

Code
get_summary_stats <- function(demo_wide_clean) {
  summary_stats <- summary(demo_wide_clean)
  return(summary_stats)
}

Data Importation and Initial Preparation:

Import data sets related to the main task, attention checks, and demographics.

Code
data_categorization_jwish_first <- read_csv("../Data/data_exp_143127-v17_task-jwishfirstrealdata.csv", show_col_types = FALSE)
data_categorization_Arab_first <- read_csv("../Data/data_exp_143127-v17_task-4qo7Arabfirstrealdata.csv", show_col_types = FALSE)
  
att_check <-  read_csv("../Data/data_exp_143127-v17_task-sfst_ATTcheck.csv", show_col_types = F)

data_demo <- read_csv("../Data/data_exp_143127-v17_questionnaire-jj6n_demo_all_long_for.csv", show_col_types = F)

Attention Check and Participant Filtering:

Data arrangement(Binding- will not be nessasery in the actual analysis)

Code
att_check <- att_check |>
  colnames_to_underscores() |>
  dplyr::filter(str_detect(Zone_Type, pattern = "endValue")) |>
  dplyr::select(Participant_Private_ID, Response) |>
  dplyr::mutate(Participant_Private_ID = factor(Participant_Private_ID))

Identify and exclude participants who failed the attention checks

Identifying who failed the attention checks (answer > 5)

Code
failed_IDs <- att_check |>
  dplyr::filter(Response > 5) |>
  dplyr::select(Participant_Private_ID)

Data cleaning and Outlier Detection:

Cleaning data before filtering outliers

  • Merge task-related data from different data- sets and filter out participants who failed the attention checks.
  • Organizing the primary data for participants, including labeling and introducing a column to denote the order of conditions.
Code
library(dplyr)
data_participants <- rbind(data_categorization_Arab_first,data_categorization_jwish_first)|>
  colnames_to_underscores() |>
  dplyr::filter(!(Participant_Private_ID %in% failed_IDs$Participant_Private_ID)) |>
  dplyr::filter(display %in% c("task_Jewish", "task_Arab")) |> # removing instructions screens
  dplyr::filter(Zone_Type == "response_slider_endValue") |> # only subjects answers
  dplyr::select(Participant_Private_ID, Response, image, Reaction_Time, display, Task_Name) |>
  mutate(Participant_Private_ID = factor(Participant_Private_ID),
         image = factor(image),
         Task_Name = factor(Task_Name),
         display = factor(display)) |>
  mutate(Task_Name =  case_when(
    Task_Name == "Group_categorization_JewishFirst_pilot2" ~ "JewishFirst",
    Task_Name == "Group_categorization_ArabFirst_pilot2" ~ "ArabFirst",
    TRUE ~ Task_Name  
  )) |>
  rename(order_of_conditions = Task_Name)

num_participants <- n_distinct(data_participants$Participant_Private_ID)

data set without the subject-

exclude_participant_IDs <- c("10528079", "10515904", "10520649", "10529232")  

# # Combine data and perform initial processing with dynamic exclusion
# data_participants_Without_10513794 <- data_participants|>
#   dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
# 
# data_participants_Without_10515904 <- data_participants|>
#   dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
# 
# data_participants_Without_10520649 <- data_participants|>
#   dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
# 
# data_participants_Without_10528079 <- data_participants|>
#   dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))


data_participants_without_all <- data_participants|>
  dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
num_participants <- n_distinct(data_participants_without_all$Participant_Private_ID)

visualizing responses by display

Density plots for participants’ responses based on the dysplay conditions, labeled as “task Arab” versus “task Jewish.”

Code
# same but with outliers
density_plot <- ggplot(data_participants_without_all, aes(x = Response, fill = display)) + 
  geom_density(alpha = 0.5) + # Plot density
  geom_rug(aes(color = display), sides = "b") + # Add rug plot at the bottom
  scale_fill_brewer(palette = "Pastel1") + # Use Pastel1 palette for fill
  scale_color_brewer(palette = "Pastel1") + # Use Pastel1 palette for rug and mean line colors
  theme_minimal() + 
  labs(title = "Density of Ratings by Display", x = "Rating", y = "Density") +
  geom_vline(data = data_participants_without_all %>% group_by(display) |> 
               summarise(mean_response = mean(Response, na.rm = TRUE)),
             aes(xintercept = mean_response),
             linetype = "dashed", color = "black", size = 0.5) 



ggsave("density_plot_without_some_subjects.png", density_plot, path = "../Plots_outliers/", width = 10, height = 8, units = "in", bg = "white")

Detecting outlires

Identify and exclude outliers from our data set using The MAD-median rule for outlier removal as recommended by Bakker and Wicherts (2014).

Second option to pbtain the MAD MEDIAN ROLE for detecting outlires (better in my opinion) link.

Code
#Threshold Determiantion

threshold <- 2.24
# Calculate the median and MAD for the Response column
median_response <- median(data_participants$Response, na.rm = TRUE)
mad_response <- mad(data_participants$Response, constant = 1, na.rm = TRUE)

lower_bound <- median_response - threshold * mad_response
upper_bound <- median_response + threshold * mad_response

outlier_indices <- which(data_participants$Response < lower_bound | data_participants$Response > upper_bound)


data_participants$is_outlier <- ifelse(data_participants$Response < lower_bound | data_participants$Response > upper_bound, 1, 0)

outliers <- data_participants[outlier_indices, ]
data_cleaned <- data_participants[!data_participants$Response %in% outliers$Response, ]

data_cleaned_without_some_subjects <- data_participants[!data_participants$Response %in% outliers$Response, ] |>
  dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))



set.seed(14)

# test <- data_participants |>
#   #mutate(is_outlier = sample(x = c(0, 1), size = nrow(data_participants), replace = T, prob = c(.8, .2))) |>
#   filter(is_outlier == 1) |>
#   group_by(Participant_Private_ID) |>
#   mutate(n_trials = n()) |>
#   mutate(bad_trials = 85*2 - n_trials) |>
#   mutate(percent_bad_trials = n_bad_trials / (85*2)) 
#   #filter(percent_bad_trials <= 0.2)
# library(dplyr)  

test1 <- data_participants |>
    # mutate(is_outlier = sample(x = c(0, 1), size = nrow(data_participants), replace = TRUE, prob = c(.8, .2))) |>
    filter(is_outlier == 1) |>
    group_by(Participant_Private_ID) |>
    mutate(bad_trials = n(), 
           #bad_trials = 85 * 2 - n_trials, 
           percent_bad_trials = bad_trials / (85 * 2))

num_participants_out <- n_distinct(test1$Participant_Private_ID)

SD table

A table showing the average standard deviation of each subject’s ratings beyond display types

Code
participant_sd_ratings <- data_participants_without_all |>
  group_by(Participant_Private_ID) |>
  summarise(SD_of_Ratings = sd(Response, na.rm = TRUE)) |>
  ungroup()

kable(participant_sd_ratings, caption = "Standard Deviation of Ratings for Each Participant")
Standard Deviation of Ratings for Each Participant
Participant_Private_ID SD_of_Ratings
10514858 19.72960
10515072 41.73836
10515173 23.39740
10515193 31.32064
10515201 36.83332
10515243 40.58422
10515319 35.68966
10515327 32.17920
10515918 22.24714
10515942 10.57305
10515960 19.62875
10515998 35.48673
10516258 24.88498
10516270 25.19615
10516302 29.10667
10516415 32.04238
10516645 22.79964
10516756 20.96220
10517522 29.27106
10517752 37.97194
10517925 40.37224
10518377 24.35308
10519057 37.29496
10519217 11.59149
10519319 29.61986
10519805 32.12981
10520066 21.90053
10520207 32.73827
10520244 25.67647
10520416 28.98994
10520443 26.83289
10520738 28.81733
10522475 29.30831
10522511 18.49479
10522561 27.52098
10527960 31.49570
10528402 12.17067
10528576 30.03514
10530076 37.41983
10530576 20.11152
10530858 29.53245
10531834 23.79220

examining order effect:

Examining how the order of conditions affects ratings of images as “Arab” or “Jewish,” to ensure there is no influence of presentation sequence on perceptions. Visualization of order effect

Code
# Visualization of order effects
order_effect_plot <- ggplot(data_participants_without_all, aes(x = order_of_conditions, y = Response, fill = display)) +
  geom_boxplot() +
  stat_summary(fun = mean, geom = "errorbar", aes(ymax = ..y.., ymin = ..y..), width = 0.75, color = "red") +
  facet_wrap(~display, scales = "free") +
  labs(title = "Order Effect on Ratings",
       x = "Order of Conditions",
       y = "Rating") +
  theme_minimal() +
  theme(plot.background = element_rect(fill = "white"), # Set plot background to white
        panel.background = element_rect(fill = "white"), # Ensure panel background is white
        text = element_text(color = "black")) + # Ensure text is black
  scale_fill_brewer(palette = "Pastel1")


ggsave("order_effect_without_outlires.png", order_effect_plot, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")

Perform a t-test to see if there’s a significant difference in ratings between orders

Code
mean_ratings_by_order <- data_participants_without_all |>
  group_by(order_of_conditions, display) |>
  summarise(mean_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
  pivot_wider(names_from = display, values_from = mean_rating)


t_test_result_jewish <- t.test(Response ~ order_of_conditions,
                               data = dplyr::filter(data_participants_without_all, display == "task_Jewish"),
                               alternative = "two.sided")

t_test_result_arab <- t.test(Response ~ order_of_conditions,
                             data = dplyr::filter(data_participants_without_all, display == "task_Arab"),
                             alternative = "two.sided")

T-test result

Code
t_test_results_without_all <- data.frame(
  Display = c("Jewish", "Arab"),
  Statistic = c(t_test_result_jewish$statistic, t_test_result_arab$statistic),
  P_Value = c(t_test_result_jewish$p.value, t_test_result_arab$p.value)  # Difference of means, NA for the second row
)

# Create a table from the results
kable(t_test_results_without_all, caption = "T-Test Results for Jewish and Arab Displays", format = "markdown")
T-Test Results for Jewish and Arab Displays
Display Statistic P_Value
Jewish 1.602234 0.1091925
Arab -2.229192 0.0258633

Main task

Difference of means per image by display with a cutoff of 10 points difference between the ratings

  • Analyze the main task by calculating and comparing mean responses for different image categories.
  • Identify significant differences in means and categorize images based on these differences.
Code
data_images_10<- data_participants_without_all |>
  group_by(image, Participant_Private_ID) |>
  #dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))|>
  dplyr::summarize(
    task_Jewish = mean(Response[display == "task_Jewish"], na.rm = TRUE),
    task_Arab = mean(Response[display == "task_Arab"], na.rm = TRUE),
    .groups = 'drop'  ) |> # Calculate the difference in ratings for each participant and image
  mutate(diff_per_participant = task_Jewish - task_Arab) |>
  # Aggregate at the image level
  group_by(image) |>
  dplyr::summarize(
    avg_diff = mean(diff_per_participant, na.rm = TRUE),
    .groups = 'drop') |># Classify based on the average difference
  mutate(
    rated_ethnicity = case_when(
      avg_diff < -10 ~ "Arab",
      avg_diff > 10 ~ "Jewish",
      TRUE ~ "Ambiguous"
    )
  )|>
  mutate(avg_diff = abs(avg_diff)) |>
  arrange(avg_diff)

data_images_big_diff_10 <- data_images_10 |>
  dplyr::filter(abs(avg_diff) >= 10) |>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))


data_images_choosen_10 <- data_images_10 |>
  dplyr::filter(abs(avg_diff)<10)|>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))
kable(data_images_10, caption = "Difference of means with a cutoff of 10 points")
Difference of means with a cutoff of 10 points
image avg_diff rated_ethnicity
CFD_M-242-N.png 0.4047619 Ambiguous
CFD_M-212-N.png 0.5476190 Ambiguous
IFD_M-419-N.png 0.5714286 Ambiguous
CFD_M-236-N.png 1.2380952 Ambiguous
CFD_M-220-N.png 1.3809524 Ambiguous
CFD_M-234-N.png 1.5000000 Ambiguous
CFD_M-206-N.png 1.8809524 Ambiguous
IFD_M-018-N.png 2.1904762 Ambiguous
CFD_M-227-N.png 2.2142857 Ambiguous
CFD_M-224-N.png 2.8571429 Ambiguous
CFD_M-218-N.png 4.0952381 Ambiguous
CFD_M-211-N.png 4.9761905 Ambiguous
IFD_M-108-N.png 5.1666667 Ambiguous
CFD_M-214-N.png 5.3809524 Ambiguous
IFD_M-135-N.png 5.3809524 Ambiguous
IFD_M-416-N.png 5.8095238 Ambiguous
IFD_M-105-N.png 6.2142857 Ambiguous
CFD_M-237-N.png 6.3095238 Ambiguous
CFD_M-216-N.png 6.5000000 Ambiguous
CFD_M-248-N.png 6.8571429 Ambiguous
CFD_M-243-N.png 7.0238095 Ambiguous
CFD_M-229-N.png 7.3571429 Ambiguous
IFD_M-086-N.png 7.5476190 Ambiguous
CFD_M-247-N.png 7.5714286 Ambiguous
IFD_M-067-N.png 7.9761905 Ambiguous
CFD_M-253-N.png 8.2380952 Ambiguous
IFD_M-424-N.png 9.8095238 Ambiguous
CFD_M-225-N.png 9.8809524 Ambiguous
IFD_M-132-N.png 9.9523810 Ambiguous
IFD_M-421-N.png 10.0476190 Jewish
IFD_M-136-N.png 12.8809524 Arab
IFD_M-420-N.png 14.2619048 Arab
CFD_M-213-N.png 14.4047619 Arab
IFD_M-117-N.png 14.5952381 Jewish
CFD_M-231-N.png 14.7857143 Jewish
CFD_M-222-N.png 15.4047619 Jewish
IFD_M-062-N.png 15.4285714 Arab
CFD_M-223-N.png 15.6666667 Arab
CFD_M-246-N.png 16.1428571 Arab
IFD_M-075-N.png 16.7142857 Arab
CFD_M-230-N.png 16.8333333 Arab
IFD_M-121-N.png 16.8571429 Jewish
IFD_M-036-N.png 16.8809524 Jewish
CFD_M-204-N.png 16.9761905 Jewish
IFD_M-100-N.png 18.4285714 Jewish
CFD_M-251-N.png 18.6428571 Jewish
IFD_M-042-N.png 18.8809524 Arab
IFD_M-122-N.png 19.1190476 Jewish
CFD_M-200-N.png 19.3333333 Jewish
CFD_M-221-N.png 19.5952381 Jewish
IFD_M-044-N.png 19.6666667 Arab
CFD_M-252-N.png 20.0238095 Arab
CFD_M-239-N.png 20.2380952 Arab
IFD_M-033-N.png 21.1904762 Jewish
IFD_M-418-N.png 21.5238095 Jewish
IFD_M-441-N.png 22.7619048 Jewish
IFD_M-021-N.png 22.8095238 Jewish
IFD_M-051-N.png 23.1190476 Arab
IFD_M-111-N.png 23.1190476 Arab
CFD_M-210-N.png 23.2142857 Arab
IFD_M-087-N.png 24.5238095 Jewish
CFD_M-238-N.png 24.8571429 Arab
IFD_M-015-N.png 25.1190476 Jewish
IFD_M-113-N.png 25.9047619 Jewish
IFD_M-084-N.png 26.2142857 Arab
CFD_M-232-N.png 26.7857143 Arab
IFD_M-097-N.png 27.3571429 Arab
IFD_M-032-N.png 27.4285714 Arab
IFD_M-020-N.png 28.1666667 Arab
IFD_M-035-N.png 28.9285714 Jewish
CFD_M-235-N.png 29.5238095 Arab
IFD_M-049-N.png 29.8095238 Arab
IFD_M-017-N.png 33.7857143 Jewish
IFD_M-114-N.png 34.0714286 Jewish
CFD_M-250-N.png 36.2380952 Jewish
IFD_M-069-N.png 38.3571429 Arab
IFD_M-028-N.png 40.6190476 Jewish
CFD_M-201-N.png 40.9761905 Jewish
IFD_M-423-N.png 41.7380952 Arab
IFD_M-107-N.png 47.4047619 Arab
CFD_M-202-N.png 49.4047619 Arab
IFD_M-066-N.png 59.4047619 Arab
IFD_M-039-N.png 60.4047619 Arab
IFD_M-045-N.png 60.8095238 Arab
IFD_M-046-N.png 68.8333333 Arab
Code
saveRDS(data_images_10, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")

Summary Table:

Code
summary_table_10 <- data_images_10 |>
  count(rated_ethnicity) |>
  spread(key = rated_ethnicity, value = n)

# Print the summary table
kable(summary_table_10, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")
Summary of Rated Ethnicity
Ambiguous Arab Jewish
29 31 25

Difference of means per image by display with a cutoff of 15 points difference between the ratings

Code
data_images_15<- data_participants_without_all |>
  group_by(image, Participant_Private_ID) |>
  #dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))|>
  dplyr::summarize(
    task_Jewish = mean(Response[display == "task_Jewish"], na.rm = TRUE),
    task_Arab = mean(Response[display == "task_Arab"], na.rm = TRUE),
    .groups = 'drop'  ) |> # Calculate the difference in ratings for each participant and image
  mutate(diff_per_participant = task_Jewish - task_Arab) |>
  # Aggregate at the image level
  group_by(image) |>
  dplyr::summarize(
    avg_diff = mean(diff_per_participant, na.rm = TRUE),
    .groups = 'drop') |># Classify based on the average difference
  mutate(
    rated_ethnicity = case_when(
      avg_diff < -15 ~ "Arab",
      avg_diff > 15 ~ "Jewish",
      TRUE ~ "Ambiguous"
    )
  )|>
  mutate(avg_diff = abs(avg_diff)) |>
  arrange(avg_diff)

data_images_big_diff_15 <- data_images_15 |>
  dplyr::filter(abs(avg_diff) >= 15) |>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))
data_images_choosen_15 <- data_images_15 |>
  dplyr::filter(abs(avg_diff)<15)|>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))

kable(data_images_15, caption = "Difference of means with a cutoff of 15 points")
Difference of means with a cutoff of 15 points
image avg_diff rated_ethnicity
CFD_M-242-N.png 0.4047619 Ambiguous
CFD_M-212-N.png 0.5476190 Ambiguous
IFD_M-419-N.png 0.5714286 Ambiguous
CFD_M-236-N.png 1.2380952 Ambiguous
CFD_M-220-N.png 1.3809524 Ambiguous
CFD_M-234-N.png 1.5000000 Ambiguous
CFD_M-206-N.png 1.8809524 Ambiguous
IFD_M-018-N.png 2.1904762 Ambiguous
CFD_M-227-N.png 2.2142857 Ambiguous
CFD_M-224-N.png 2.8571429 Ambiguous
CFD_M-218-N.png 4.0952381 Ambiguous
CFD_M-211-N.png 4.9761905 Ambiguous
IFD_M-108-N.png 5.1666667 Ambiguous
CFD_M-214-N.png 5.3809524 Ambiguous
IFD_M-135-N.png 5.3809524 Ambiguous
IFD_M-416-N.png 5.8095238 Ambiguous
IFD_M-105-N.png 6.2142857 Ambiguous
CFD_M-237-N.png 6.3095238 Ambiguous
CFD_M-216-N.png 6.5000000 Ambiguous
CFD_M-248-N.png 6.8571429 Ambiguous
CFD_M-243-N.png 7.0238095 Ambiguous
CFD_M-229-N.png 7.3571429 Ambiguous
IFD_M-086-N.png 7.5476190 Ambiguous
CFD_M-247-N.png 7.5714286 Ambiguous
IFD_M-067-N.png 7.9761905 Ambiguous
CFD_M-253-N.png 8.2380952 Ambiguous
IFD_M-424-N.png 9.8095238 Ambiguous
CFD_M-225-N.png 9.8809524 Ambiguous
IFD_M-132-N.png 9.9523810 Ambiguous
IFD_M-421-N.png 10.0476190 Ambiguous
IFD_M-136-N.png 12.8809524 Ambiguous
IFD_M-420-N.png 14.2619048 Ambiguous
CFD_M-213-N.png 14.4047619 Ambiguous
IFD_M-117-N.png 14.5952381 Ambiguous
CFD_M-231-N.png 14.7857143 Ambiguous
CFD_M-222-N.png 15.4047619 Jewish
IFD_M-062-N.png 15.4285714 Arab
CFD_M-223-N.png 15.6666667 Arab
CFD_M-246-N.png 16.1428571 Arab
IFD_M-075-N.png 16.7142857 Arab
CFD_M-230-N.png 16.8333333 Arab
IFD_M-121-N.png 16.8571429 Jewish
IFD_M-036-N.png 16.8809524 Jewish
CFD_M-204-N.png 16.9761905 Jewish
IFD_M-100-N.png 18.4285714 Jewish
CFD_M-251-N.png 18.6428571 Jewish
IFD_M-042-N.png 18.8809524 Arab
IFD_M-122-N.png 19.1190476 Jewish
CFD_M-200-N.png 19.3333333 Jewish
CFD_M-221-N.png 19.5952381 Jewish
IFD_M-044-N.png 19.6666667 Arab
CFD_M-252-N.png 20.0238095 Arab
CFD_M-239-N.png 20.2380952 Arab
IFD_M-033-N.png 21.1904762 Jewish
IFD_M-418-N.png 21.5238095 Jewish
IFD_M-441-N.png 22.7619048 Jewish
IFD_M-021-N.png 22.8095238 Jewish
IFD_M-051-N.png 23.1190476 Arab
IFD_M-111-N.png 23.1190476 Arab
CFD_M-210-N.png 23.2142857 Arab
IFD_M-087-N.png 24.5238095 Jewish
CFD_M-238-N.png 24.8571429 Arab
IFD_M-015-N.png 25.1190476 Jewish
IFD_M-113-N.png 25.9047619 Jewish
IFD_M-084-N.png 26.2142857 Arab
CFD_M-232-N.png 26.7857143 Arab
IFD_M-097-N.png 27.3571429 Arab
IFD_M-032-N.png 27.4285714 Arab
IFD_M-020-N.png 28.1666667 Arab
IFD_M-035-N.png 28.9285714 Jewish
CFD_M-235-N.png 29.5238095 Arab
IFD_M-049-N.png 29.8095238 Arab
IFD_M-017-N.png 33.7857143 Jewish
IFD_M-114-N.png 34.0714286 Jewish
CFD_M-250-N.png 36.2380952 Jewish
IFD_M-069-N.png 38.3571429 Arab
IFD_M-028-N.png 40.6190476 Jewish
CFD_M-201-N.png 40.9761905 Jewish
IFD_M-423-N.png 41.7380952 Arab
IFD_M-107-N.png 47.4047619 Arab
CFD_M-202-N.png 49.4047619 Arab
IFD_M-066-N.png 59.4047619 Arab
IFD_M-039-N.png 60.4047619 Arab
IFD_M-045-N.png 60.8095238 Arab
IFD_M-046-N.png 68.8333333 Arab
Code
saveRDS(data_images_15, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")

Summary Table:

Code
summary_table_15 <- data_images_15 |>
  count(rated_ethnicity) |>
  spread(key = rated_ethnicity, value = n)

# Print the summary table
kable(summary_table_15, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")
Summary of Rated Ethnicity
Ambiguous Arab Jewish
35 28 22

Difference of means per image by display with a cutoff of 20 points difference between the ratings

Code
data_images_20<- data_participants_without_all |>
  group_by(image, Participant_Private_ID) |>
  #dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))|>
  dplyr::summarize(
    task_Jewish = mean(Response[display == "task_Jewish"], na.rm = TRUE),
    task_Arab = mean(Response[display == "task_Arab"], na.rm = TRUE),
    .groups = 'drop'  ) |> # Calculate the difference in ratings for each participant and image
  mutate(diff_per_participant = task_Jewish - task_Arab) |>
  # Aggregate at the image level
  group_by(image) |>
  dplyr::summarize(
    avg_diff = mean(diff_per_participant, na.rm = TRUE),
    .groups = 'drop') |># Classify based on the average difference
  mutate(
    rated_ethnicity = case_when(
      avg_diff < -20 ~ "Arab",
      avg_diff > 20 ~ "Jewish",
      TRUE ~ "Ambiguous"
    )
  )|>
  mutate(avg_diff = abs(avg_diff)) |>
  arrange(avg_diff)

data_images_big_diff_20 <- data_images_20 |>
  dplyr::filter(abs(avg_diff) >= 20) |>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))
data_images_choosen_20 <- data_images_20 |>
  dplyr::filter(abs(avg_diff)<20)|>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))

kable(data_images_20, caption = "Difference of means with a cutoff of 20 points")
Difference of means with a cutoff of 20 points
image avg_diff rated_ethnicity
CFD_M-242-N.png 0.4047619 Ambiguous
CFD_M-212-N.png 0.5476190 Ambiguous
IFD_M-419-N.png 0.5714286 Ambiguous
CFD_M-236-N.png 1.2380952 Ambiguous
CFD_M-220-N.png 1.3809524 Ambiguous
CFD_M-234-N.png 1.5000000 Ambiguous
CFD_M-206-N.png 1.8809524 Ambiguous
IFD_M-018-N.png 2.1904762 Ambiguous
CFD_M-227-N.png 2.2142857 Ambiguous
CFD_M-224-N.png 2.8571429 Ambiguous
CFD_M-218-N.png 4.0952381 Ambiguous
CFD_M-211-N.png 4.9761905 Ambiguous
IFD_M-108-N.png 5.1666667 Ambiguous
CFD_M-214-N.png 5.3809524 Ambiguous
IFD_M-135-N.png 5.3809524 Ambiguous
IFD_M-416-N.png 5.8095238 Ambiguous
IFD_M-105-N.png 6.2142857 Ambiguous
CFD_M-237-N.png 6.3095238 Ambiguous
CFD_M-216-N.png 6.5000000 Ambiguous
CFD_M-248-N.png 6.8571429 Ambiguous
CFD_M-243-N.png 7.0238095 Ambiguous
CFD_M-229-N.png 7.3571429 Ambiguous
IFD_M-086-N.png 7.5476190 Ambiguous
CFD_M-247-N.png 7.5714286 Ambiguous
IFD_M-067-N.png 7.9761905 Ambiguous
CFD_M-253-N.png 8.2380952 Ambiguous
IFD_M-424-N.png 9.8095238 Ambiguous
CFD_M-225-N.png 9.8809524 Ambiguous
IFD_M-132-N.png 9.9523810 Ambiguous
IFD_M-421-N.png 10.0476190 Ambiguous
IFD_M-136-N.png 12.8809524 Ambiguous
IFD_M-420-N.png 14.2619048 Ambiguous
CFD_M-213-N.png 14.4047619 Ambiguous
IFD_M-117-N.png 14.5952381 Ambiguous
CFD_M-231-N.png 14.7857143 Ambiguous
CFD_M-222-N.png 15.4047619 Ambiguous
IFD_M-062-N.png 15.4285714 Ambiguous
CFD_M-223-N.png 15.6666667 Ambiguous
CFD_M-246-N.png 16.1428571 Ambiguous
IFD_M-075-N.png 16.7142857 Ambiguous
CFD_M-230-N.png 16.8333333 Ambiguous
IFD_M-121-N.png 16.8571429 Ambiguous
IFD_M-036-N.png 16.8809524 Ambiguous
CFD_M-204-N.png 16.9761905 Ambiguous
IFD_M-100-N.png 18.4285714 Ambiguous
CFD_M-251-N.png 18.6428571 Ambiguous
IFD_M-042-N.png 18.8809524 Ambiguous
IFD_M-122-N.png 19.1190476 Ambiguous
CFD_M-200-N.png 19.3333333 Ambiguous
CFD_M-221-N.png 19.5952381 Ambiguous
IFD_M-044-N.png 19.6666667 Ambiguous
CFD_M-252-N.png 20.0238095 Arab
CFD_M-239-N.png 20.2380952 Arab
IFD_M-033-N.png 21.1904762 Jewish
IFD_M-418-N.png 21.5238095 Jewish
IFD_M-441-N.png 22.7619048 Jewish
IFD_M-021-N.png 22.8095238 Jewish
IFD_M-051-N.png 23.1190476 Arab
IFD_M-111-N.png 23.1190476 Arab
CFD_M-210-N.png 23.2142857 Arab
IFD_M-087-N.png 24.5238095 Jewish
CFD_M-238-N.png 24.8571429 Arab
IFD_M-015-N.png 25.1190476 Jewish
IFD_M-113-N.png 25.9047619 Jewish
IFD_M-084-N.png 26.2142857 Arab
CFD_M-232-N.png 26.7857143 Arab
IFD_M-097-N.png 27.3571429 Arab
IFD_M-032-N.png 27.4285714 Arab
IFD_M-020-N.png 28.1666667 Arab
IFD_M-035-N.png 28.9285714 Jewish
CFD_M-235-N.png 29.5238095 Arab
IFD_M-049-N.png 29.8095238 Arab
IFD_M-017-N.png 33.7857143 Jewish
IFD_M-114-N.png 34.0714286 Jewish
CFD_M-250-N.png 36.2380952 Jewish
IFD_M-069-N.png 38.3571429 Arab
IFD_M-028-N.png 40.6190476 Jewish
CFD_M-201-N.png 40.9761905 Jewish
IFD_M-423-N.png 41.7380952 Arab
IFD_M-107-N.png 47.4047619 Arab
CFD_M-202-N.png 49.4047619 Arab
IFD_M-066-N.png 59.4047619 Arab
IFD_M-039-N.png 60.4047619 Arab
IFD_M-045-N.png 60.8095238 Arab
IFD_M-046-N.png 68.8333333 Arab
Code
saveRDS(data_images_20, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")

Summary Table:

Code
summary_table_20 <- data_images_20 |>
  count(rated_ethnicity) |>
  spread(key = rated_ethnicity, value = n)

# Print the summary table
kable(summary_table_20, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")
Summary of Rated Ethnicity
Ambiguous Arab Jewish
51 21 13

Difference of means per image by display without outlires and particular participants

  • Analyze the main task by calculating and comparing mean responses for different image categories.
  • Identify significant differences in means and categorize images based on these differences.

Visualization with ggplot2:

Demographics

Data_set arrangment

  • Import and clean demographic data.
  • Perform necessary transformations and renamings of demographic variables.
  • Generate summary statistics and visualizations for demographic variables such as age, gender, religiosity, education, and socio-economic status.
Code
data_demo <- data_demo |>
  colnames_to_underscores() |>
  dplyr::filter(!(Question_Key %in% c("BEGIN QUESTIONNAIRE", "END QUESTIONNAIRE"))) |>
  dplyr::filter(Event_Index != "END OF FILE") |>
  select(Participant_Private_ID, Question_Key, Response) |>
  pivot_wider(names_from = Question_Key, values_from = Response)

#data_demo$gender[3] <- "אישה"
Code
demo_wide_clean <- data_demo |>
  mutate(gender = case_when(`gender-quantised` == "1" ~ "man",
                            `gender-quantised` == "2" ~ "woman")) |>
  select(-`gender-quantised`, -`gender-quantised`, -`gender-text`, -`ethnic-text`, -`religiosity-quantised`, -`scale_of_SES-quantised`, -`age-quantised`) |>
  mutate(Participant_Private_ID = factor(Participant_Private_ID),
         age = as.numeric(age),
         children = as.numeric(children),
         scale_of_SES = as.numeric(scale_of_SES))

# demo_wide_clean$`ethnic-1`[3] <- "ישראלי/ת"
# demo_wide_clean$`ethnic-4` <- "יהודי/ת"
# demo_wide_clean$education[3] <- " למדתי לימודים מתקדמים מעבר לתואר ראשון"

Rename columns

Code
demo_wide_clean <- demo_wide_clean |>
  rename(ethnic = `ethnic-1`, SES = scale_of_SES, comment = `response-7`, ethnic2 = `ethnic-4`, )

separatlly visualizations and summary statistics for demographic variables

Age

Code
ggplot(demo_wide_clean, aes(x = age)) +
  geom_histogram(bins = 50) +
  scale_x_continuous(breaks = seq(17, 71, 2)) +
  theme_classic()

Summary Table for AGE stat:

Code
Age_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$age)))

if (!requireNamespace("knitr", quietly = TRUE)) {
  install.packages("knitr")
}

library(knitr)

# Generate a nice table using kable
kable(Age_stats, caption = "Summary Statistics for Age", format = "markdown")
Summary Statistics for Age
as.numeric(demo_wide_clean$age)
Min. :18.00
1st Qu.:23.00
Median :30.00
Mean :29.49
3rd Qu.:33.00
Max. :72.00
NA’s :2
Code
Age_stats_df <- data.frame(
  Statistic = c("Mean", "Median", "SD", "Min", "Max"),
  Value = c(mean(demo_wide_clean$age, na.rm = TRUE), 
            median(demo_wide_clean$age, na.rm = TRUE), 
            sd(demo_wide_clean$age, na.rm = TRUE), 
            min(demo_wide_clean$age, na.rm = TRUE), 
            max(demo_wide_clean$age, na.rm = TRUE))
)

kable(Age_stats_df, caption = "Summary Statistics for Age", format = "markdown")
Summary Statistics for Age
Statistic Value
Mean 29.4898
Median 30.0000
SD 10.2533
Min 18.0000
Max 72.0000

Gender

Code
ggplot(demo_wide_clean, aes(x = gender)) +
  geom_histogram(stat = "count") +
  scale_y_continuous(breaks = seq(0, 200, 10)) +
  theme_classic()

Code
male_per <- sum(demo_wide_clean$gender == "man", na.rm = TRUE) / 
            sum(!is.na(demo_wide_clean$gender))

female_per <- sum(demo_wide_clean$gender == "woman", na.rm = T) /
   sum(!is.na(demo_wide_clean$gender))
a_baniari_per <- sum(demo_wide_clean$gender == "לא בינארי", na.rm = T)/
  sum(!is.na(demo_wide_clean$gender))

Religiosity

Code
ggplot(demo_wide_clean, aes(x = religiosity)) +
  geom_histogram(stat = "count") +
  scale_y_continuous(breaks = seq(0, 200, 10)) +
  theme_classic()

Summary Table for Religiosity stat:

Code
religiosity_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$religiosity)))
Age_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$age)))

if (!requireNamespace("knitr", quietly = TRUE)) {
  install.packages("knitr")
}

library(knitr)
str(demo_wide_clean)
tibble [51 × 16] (S3: tbl_df/tbl/data.frame)
 $ Participant_Private_ID: Factor w/ 51 levels "10514858","10515072",..: 1 2 3 4 5 6 7 8 9 10 ...
 $ age                   : num [1:51] 19 72 22 19 27 22 19 26 27 29 ...
 $ gender                : chr [1:51] "man" "man" "man" "woman" ...
 $ ethnic                : chr [1:51] "ישראלי/ת" "ישראלי/ת" NA "ישראלי/ת" ...
 $ ethnic2               : chr [1:51] "יהודי/ת" "יהודי/ת" NA "יהודי/ת" ...
 $ ethnic-8              : chr [1:51] "חרד/ית" NA "חרד/ית" NA ...
 $ religiosity           : chr [1:51] "9" "3" "8" "1" ...
 $ education             : chr [1:51] "למדתי לימודים מתקדמים מעבר לתואר ראשון" "השלמתי תואר ראשון באוניברסיטה" "השלמתי בית ספר יסודי" "השלמתי בית ספר תיכון" ...
 $ education-quantised   : chr [1:51] "7" "6" "2" "4" ...
 $ language              : chr [1:51] "כן" "כן" "כן" "כן" ...
 $ language -quantised   : chr [1:51] "1" "1" "1" "1" ...
 $ vision                : chr [1:51] "ראייה מתוקנת (משקפיים/עדשות)" "ראייה מתוקנת (משקפיים/עדשות)" "ראייה מתוקנת (משקפיים/עדשות)" "כן" ...
 $ vision-quantised      : chr [1:51] "2" "2" "2" "1" ...
 $ children              : num [1:51] 1 2 1 0 0 0 0 0 0 3 ...
 $ SES                   : num [1:51] 6 8 5 6 6 7 7 5 6 4 ...
 $ comment               : chr [1:51] NA NA NA NA ...
Code
demo_wide_clean$religiosity <- as.numeric(as.character(demo_wide_clean$religiosity))
# Generate a nice table using kable
kable(religiosity_stats, caption = "Summary Statistics for religiosity", format = "markdown")
Summary Statistics for religiosity
as.numeric(demo_wide_clean$religiosity)
Min. : 1.000
1st Qu.: 3.000
Median : 6.000
Mean : 5.588
3rd Qu.: 8.000
Max. :10.000
Code
relig_stats_df <- data.frame(
  Statistic = c("Mean", "Median", "SD", "Min", "Max"),
  Value = c(mean(demo_wide_clean$religiosity, na.rm = TRUE), 
            median(demo_wide_clean$religiosity, na.rm = TRUE), 
            sd(demo_wide_clean$religiosity, na.rm = TRUE), 
            min(demo_wide_clean$religiosity, na.rm = TRUE), 
            max(demo_wide_clean$religiosity, na.rm = TRUE))
)

kable(relig_stats_df, caption = "Summary Statistics for Religiosity", format = "markdown")
Summary Statistics for Religiosity
Statistic Value
Mean 5.588235
Median 6.000000
SD 3.093066
Min 1.000000
Max 10.000000
Code
demo_table <- flextable::summarizor(demo_wide_clean[,-1], overall_label = "overall") |>
  flextable::as_flextable(sep_w = 0, spread_first_col = T)

Education

Code
education_levels <- c('1' = 'Part of Primary School', '2' = 'Finished Primary School', '3' =  'Part of High School', '4' = 'Finished High School', '5' = 'In Bachelor\'s Degree', '6' = 'Finished Bachelor\'s Degree', '7' = 'Master\'s Degree', '8' = 'Prefer not to answer')

demo_wide_clean$education <- factor(demo_wide_clean$`education-quantised`, levels = c('1', '2', '3', '4', '5', '6', '7', '8'), labels = c('Part of Primary School', 'Finished Primary School', 'Part of High School', 'Finished High School', 'In Bachelor\'s Degree', 'Finished Bachelor\'s Degree', 'Master\'s Degree', 'Prefer not to answer'))


ggplot(demo_wide_clean, aes(x = education)) +
  geom_bar() +
  scale_y_continuous(breaks = seq(0, 200, 10)) +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

SES

Code
ggplot(drop_na(demo_wide_clean, SES), aes(x = SES)) +
  geom_histogram(stat = "count", binwidth = 1) +
  stat_bin(binwidth = 1, geom = 'text', color = 'white', aes(label = after_stat(count)),
           position = position_stack(vjust = 0.5)) +
  scale_x_continuous(breaks = c(1:10)) +
  scale_y_continuous(breaks = seq(0, 160, 10)) +
  labs(title = "On a scale of 1-10 how would you rate your Social-Economic status?",
       subtitle = "1 = Lowest status, 10 = Highest status",
       y = "Number of participants",
       x = "") +
  theme_classic() +
  theme(plot.title = element_text(family = "serif", hjust = 0.5, size = 16),
        plot.subtitle = element_text(family = "serif", hjust = 0.5, size = 10))

Summary Table for SES stat:

Code
SES_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$SES)))

# Generate a nice table using kable
kable(SES_stats, caption = "Summary Statistics for SES", format = "markdown")
Summary Statistics for SES
as.numeric(demo_wide_clean$SES)
Min. :2.000
1st Qu.:5.000
Median :6.000
Mean :5.824
3rd Qu.:7.000
Max. :8.000
Code
SES_stats_df <- data.frame(
  Statistic = c("Mean", "Median", "SD", "Min", "Max"),
  Value = c(mean(demo_wide_clean$SES, na.rm = TRUE), 
            median(demo_wide_clean$SES, na.rm = TRUE), 
            sd(demo_wide_clean$SES, na.rm = TRUE), 
            min(demo_wide_clean$SES, na.rm = TRUE), 
            max(demo_wide_clean$SES, na.rm = TRUE))
)

# Now generate the table with kable
kable(SES_stats_df, caption = "Summary Statistics for SES", format = "markdown")
Summary Statistics for SES
Statistic Value
Mean 5.823529
Median 6.000000
SD 1.260252
Min 2.000000
Max 8.000000

Same Analysis, when calculating only the first rating

Adding a new column to identify the initial responses, those presented during the first condition only.

Code
data_participants_order <- data_participants_without_all |>
  mutate(order = case_when(
    display == "task_Arab" & order_of_conditions == "ArabFirst" ~ "First",
    display == "task_Jewish" & order_of_conditions == "JewishFirst" ~ "First",
    TRUE ~ "Second"  # Note the change here from '.default' to 'TRUE'
  ))
data_participants_first_only <- data_participants_order |>
  filter(order == "First")
Code
# same but with outliers
density_plot_first <- ggplot(data_participants_first_only, aes(x = Response, fill = display)) + 
  geom_density(alpha = 0.5) + # Plot density
  geom_rug(aes(color = display), sides = "b") + # Add rug plot at the bottom
  scale_fill_brewer(palette = "Pastel1") + # Use Pastel1 palette for fill
  scale_color_brewer(palette = "Pastel1") + # Use Pastel1 palette for rug and mean line colors
  theme_minimal() + 
  labs(title = "Density of Ratings by Display", x = "Rating", y = "Density") +
  geom_vline(data = data_participants_first_only %>% group_by(display) |> 
               summarise(mean_response = mean(Response, na.rm = TRUE)),
             aes(xintercept = mean_response),
             linetype = "dashed", color = "black", size = 0.5) 



ggsave("density_plot_only_first.png", density_plot_first, path = "../Plots_first/", width = 10, height = 8, units = "in", bg = "white")

SD table

A table showing the average standard deviation of each subject’s ratings beyond display types

Code
participant_sd_ratings_first <- data_participants_first_only |>
  group_by(Participant_Private_ID) |>
  summarise(SD_of_Ratings = sd(Response, na.rm = TRUE)) |>
  ungroup()

kable(participant_sd_ratings_first, caption = "Standard Deviation of Ratings for Each Participant")
Standard Deviation of Ratings for Each Participant
Participant_Private_ID SD_of_Ratings
10514858 21.82392
10515072 39.10622
10515173 23.01336
10515193 34.72058
10515201 36.20395
10515243 38.63941
10515319 33.84229
10515327 32.60062
10515918 18.02723
10515942 11.03608
10515960 21.52988
10515998 27.79639
10516258 25.53825
10516270 26.95892
10516302 23.18782
10516415 33.76182
10516645 19.74638
10516756 22.65539
10517522 20.80531
10517752 34.25632
10517925 38.87596
10518377 21.29545
10519057 30.84461
10519217 10.66527
10519319 32.69611
10519805 31.46824
10520066 17.28570
10520207 35.05864
10520244 27.08428
10520416 32.32034
10520443 24.22102
10520738 25.76987
10522475 24.71253
10522511 19.34941
10522561 25.75767
10527960 31.73418
10528402 14.74900
10528576 28.43895
10530076 36.29174
10530576 19.68271
10530858 31.83919
10531834 22.11642

Main task

A Betwwen subjects Analysis: Difference of means per image by display with a cutoff of 10 points difference between the ratings

  • Analyze the main task by calculating and comparing mean responses for different image categories.
  • Identify significant differences in means and categorize images based on these differences.
Code
data_images_comparison_10 <- data_participants_first_only |>
  group_by(image, display) |>
  summarize(average_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
  spread(key = display, value = average_rating) |>
  mutate(avg_diff = `task_Jewish` - `task_Arab`) |>
  mutate(rated_ethnicity = case_when(
    avg_diff < -10 ~ "Arab",
    avg_diff > 10 ~ "Jewish",
    TRUE ~ "Ambiguous"
  )) |>
  mutate(avg_diff = abs(avg_diff)) |>
  arrange(avg_diff)
  


data_images_big_diff_10_first <- data_images_comparison_10 |>
  dplyr::filter(abs(avg_diff) >= 10) |>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))


data_images_choosen_10_first <- data_images_comparison_10 |>
  dplyr::filter(abs(avg_diff)<10)|>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))
kable(data_images_comparison_10, caption = "Difference of means with a cutoff of 10 points")
Difference of means with a cutoff of 10 points
image task_Arab task_Jewish avg_diff rated_ethnicity
CFD_M-220-N.png 26.86364 26.90 0.0363636 Ambiguous
CFD_M-242-N.png 21.63636 21.90 0.2636364 Ambiguous
IFD_M-018-N.png 48.40909 47.60 0.8090909 Ambiguous
IFD_M-416-N.png 55.77273 54.95 0.8227273 Ambiguous
CFD_M-236-N.png 45.09091 43.70 1.3909091 Ambiguous
CFD_M-227-N.png 26.81818 28.60 1.7818182 Ambiguous
CFD_M-211-N.png 29.18182 31.05 1.8681818 Ambiguous
IFD_M-419-N.png 52.04545 54.00 1.9545455 Ambiguous
IFD_M-135-N.png 52.00000 55.30 3.3000000 Ambiguous
CFD_M-206-N.png 29.72727 25.90 3.8272727 Ambiguous
CFD_M-225-N.png 22.77273 18.50 4.2727273 Ambiguous
CFD_M-224-N.png 36.95455 41.30 4.3454545 Ambiguous
CFD_M-218-N.png 32.59091 27.95 4.6409091 Ambiguous
CFD_M-212-N.png 24.81818 29.80 4.9818182 Ambiguous
CFD_M-243-N.png 30.40909 25.35 5.0590909 Ambiguous
CFD_M-216-N.png 22.45455 16.25 6.2045455 Ambiguous
CFD_M-213-N.png 34.36364 28.00 6.3636364 Ambiguous
IFD_M-067-N.png 40.95455 34.50 6.4545455 Ambiguous
CFD_M-223-N.png 30.36364 23.80 6.5636364 Ambiguous
CFD_M-248-N.png 20.59091 27.90 7.3090909 Ambiguous
CFD_M-229-N.png 29.59091 22.10 7.4909091 Ambiguous
IFD_M-105-N.png 44.00000 53.55 9.5500000 Ambiguous
CFD_M-237-N.png 43.54545 33.85 9.6954545 Ambiguous
IFD_M-424-N.png 45.00000 34.65 10.3500000 Arab
CFD_M-234-N.png 18.54545 28.95 10.4045455 Jewish
IFD_M-086-N.png 30.72727 41.35 10.6227273 Jewish
CFD_M-214-N.png 15.90909 27.00 11.0909091 Jewish
CFD_M-251-N.png 25.54545 36.90 11.3545455 Jewish
IFD_M-108-N.png 56.59091 45.05 11.5409091 Arab
IFD_M-418-N.png 43.50000 55.35 11.8500000 Jewish
CFD_M-247-N.png 31.40909 19.50 11.9090909 Arab
IFD_M-117-N.png 35.36364 47.35 11.9863636 Jewish
CFD_M-210-N.png 41.95455 27.75 14.2045455 Arab
IFD_M-421-N.png 45.09091 59.30 14.2090909 Jewish
IFD_M-075-N.png 57.09091 41.90 15.1909091 Arab
IFD_M-121-N.png 37.72727 53.30 15.5727273 Jewish
CFD_M-204-N.png 36.04545 52.15 16.1045455 Jewish
IFD_M-132-N.png 46.31818 62.55 16.2318182 Jewish
CFD_M-222-N.png 17.40909 33.80 16.3909091 Jewish
CFD_M-200-N.png 19.40909 35.90 16.4909091 Jewish
CFD_M-253-N.png 21.22727 38.10 16.8727273 Jewish
IFD_M-051-N.png 57.09091 39.75 17.3409091 Arab
CFD_M-221-N.png 23.81818 41.75 17.9318182 Jewish
CFD_M-246-N.png 43.45455 24.30 19.1545455 Arab
CFD_M-231-N.png 19.77273 39.00 19.2272727 Jewish
IFD_M-136-N.png 63.40909 44.05 19.3590909 Arab
IFD_M-033-N.png 42.90909 62.35 19.4409091 Jewish
IFD_M-062-N.png 67.90909 47.35 20.5590909 Arab
CFD_M-230-N.png 54.81818 34.15 20.6681818 Arab
IFD_M-420-N.png 49.31818 27.80 21.5181818 Arab
IFD_M-111-N.png 66.77273 45.05 21.7227273 Arab
IFD_M-042-N.png 62.68182 40.80 21.8818182 Arab
IFD_M-122-N.png 40.81818 62.90 22.0818182 Jewish
IFD_M-100-N.png 41.54545 64.25 22.7045455 Jewish
IFD_M-084-N.png 60.36364 37.60 22.7636364 Arab
IFD_M-087-N.png 32.77273 55.55 22.7772727 Jewish
CFD_M-239-N.png 48.81818 25.70 23.1181818 Arab
IFD_M-044-N.png 60.00000 35.75 24.2500000 Arab
CFD_M-235-N.png 50.86364 26.25 24.6136364 Arab
IFD_M-015-N.png 32.77273 57.50 24.7272727 Jewish
IFD_M-097-N.png 65.09091 39.50 25.5909091 Arab
IFD_M-036-N.png 36.09091 62.50 26.4090909 Jewish
IFD_M-021-N.png 36.95455 64.65 27.6954545 Jewish
IFD_M-113-N.png 24.59091 52.85 28.2590909 Jewish
CFD_M-232-N.png 51.00000 21.95 29.0500000 Arab
IFD_M-441-N.png 28.72727 57.95 29.2227273 Jewish
IFD_M-032-N.png 64.13636 34.70 29.4363636 Arab
IFD_M-035-N.png 35.00000 65.50 30.5000000 Jewish
CFD_M-250-N.png 17.77273 48.45 30.6772727 Jewish
CFD_M-252-N.png 58.31818 27.30 31.0181818 Arab
IFD_M-114-N.png 23.31818 54.40 31.0818182 Jewish
IFD_M-049-N.png 73.59091 41.25 32.3409091 Arab
CFD_M-238-N.png 53.22727 19.95 33.2772727 Arab
IFD_M-020-N.png 65.81818 31.25 34.5681818 Arab
IFD_M-017-N.png 28.18182 64.75 36.5681818 Jewish
CFD_M-201-N.png 22.81818 62.95 40.1318182 Jewish
IFD_M-069-N.png 68.45455 27.50 40.9545455 Arab
IFD_M-423-N.png 68.22727 25.20 43.0272727 Arab
IFD_M-028-N.png 21.45455 65.05 43.5954545 Jewish
CFD_M-202-N.png 68.72727 15.35 53.3772727 Arab
IFD_M-066-N.png 85.40909 31.15 54.2590909 Arab
IFD_M-107-N.png 74.63636 19.95 54.6863636 Arab
IFD_M-045-N.png 84.95455 25.90 59.0545455 Arab
IFD_M-039-N.png 79.86364 18.00 61.8636364 Arab
IFD_M-046-N.png 84.31818 15.20 69.1181818 Arab
Code
saveRDS(data_images_10, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")

Summary Table:

Code
summary_table_10 <- data_images_comparison_10 |>
  count(rated_ethnicity) |>
  spread(key = rated_ethnicity, value = n)

# Print the summary table
kable(summary_table_10, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")
Summary of Rated Ethnicity
Ambiguous Arab Jewish
23 32 30

Comparing rating when taking into account all conditions VS only the first display:

Lets compare between the images when calculating the ratings based on all conditions VS when calculating only the first ratings:

Code
ambiguous_images_comparison_10 <- merge(data_images_10, data_images_comparison_10, by = "image", suffixes = c("_all", "_first"))

# Extracting 'Ambiguous' images from both datasets
ambiguous_images_all_10 = filter(data_images_10, rated_ethnicity == "Ambiguous")$image
ambiguous_images_first_10 = filter(data_images_comparison_10, rated_ethnicity == "Ambiguous")$image

# Finding common 'Ambiguous' images in both datasets
common_ambiguous_images_10 = intersect(ambiguous_images_all_10, ambiguous_images_first_10)

# Finding 'Ambiguous' images unique to the all conditions dataset
unique_ambiguous_all_10 = setdiff(ambiguous_images_all_10, ambiguous_images_first_10)

# Finding 'Ambiguous' images unique to the first ratings dataset
unique_ambiguous_first_10 = setdiff(ambiguous_images_first_10, ambiguous_images_all_10)

# Creating a summary table
summary_comparison_10 <- tibble(
  Common_Ambiguous_10 = length(common_ambiguous_images_10),
  Unique_Ambiguous_All_10 = length(unique_ambiguous_all_10),
  Unique_Ambiguous_First_10 = length(unique_ambiguous_first_10)
)

# Display the summary
knitr::kable(summary_comparison_10, 
             caption = "Comparison of Ambiguous Images Across Different Conditions 10",
             align = 'c')
Comparison of Ambiguous Images Across Different Conditions 10
Common_Ambiguous_10 Unique_Ambiguous_All_10 Unique_Ambiguous_First_10
21 8 2

Now let’s see the images id:

Code
common_ambiguous_images_df_10 <- tibble(Image = common_ambiguous_images_10, Category = "Common Ambiguous")
unique_ambiguous_all_df_10 <- tibble(Image = unique_ambiguous_all_10, Category = "Unique Ambiguous All")
unique_ambiguous_first_df_10 <- tibble(Image = unique_ambiguous_first_10, Category = "Unique Ambiguous First")

ambiguous_images_comparison_df_10 <- bind_rows(common_ambiguous_images_df_10, unique_ambiguous_all_df_10, unique_ambiguous_first_df_10)

# Display the comprehensive comparison
knitr::kable(ambiguous_images_comparison_df_10, 
             caption = "Comparison of Ambiguous Images Between All Conditions and First Ratings 10",
             align = 'c')
Comparison of Ambiguous Images Between All Conditions and First Ratings 10
Image Category
CFD_M-242-N.png Common Ambiguous
CFD_M-212-N.png Common Ambiguous
IFD_M-419-N.png Common Ambiguous
CFD_M-236-N.png Common Ambiguous
CFD_M-220-N.png Common Ambiguous
CFD_M-206-N.png Common Ambiguous
IFD_M-018-N.png Common Ambiguous
CFD_M-227-N.png Common Ambiguous
CFD_M-224-N.png Common Ambiguous
CFD_M-218-N.png Common Ambiguous
CFD_M-211-N.png Common Ambiguous
IFD_M-135-N.png Common Ambiguous
IFD_M-416-N.png Common Ambiguous
IFD_M-105-N.png Common Ambiguous
CFD_M-237-N.png Common Ambiguous
CFD_M-216-N.png Common Ambiguous
CFD_M-248-N.png Common Ambiguous
CFD_M-243-N.png Common Ambiguous
CFD_M-229-N.png Common Ambiguous
IFD_M-067-N.png Common Ambiguous
CFD_M-225-N.png Common Ambiguous
CFD_M-234-N.png Unique Ambiguous All
IFD_M-108-N.png Unique Ambiguous All
CFD_M-214-N.png Unique Ambiguous All
IFD_M-086-N.png Unique Ambiguous All
CFD_M-247-N.png Unique Ambiguous All
CFD_M-253-N.png Unique Ambiguous All
IFD_M-424-N.png Unique Ambiguous All
IFD_M-132-N.png Unique Ambiguous All
CFD_M-213-N.png Unique Ambiguous First
CFD_M-223-N.png Unique Ambiguous First

Difference of means per image by display with a cutoff of 15 points difference between the ratings

Code
data_images_comparison_15 <- data_participants_first_only |>
  group_by(image, display) |>
  summarize(average_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
  spread(key = display, value = average_rating) |>
  mutate(avg_diff = `task_Jewish` - `task_Arab`) |>
  mutate(rated_ethnicity = case_when(
    avg_diff < -15 ~ "Arab",
    avg_diff > 15 ~ "Jewish",
    TRUE ~ "Ambiguous"
  )) |>
  mutate(avg_diff = abs(avg_diff)) |>
  arrange(avg_diff)
  


data_images_big_diff_15_first <- data_images_comparison_15 |>
  dplyr::filter(abs(avg_diff) >= 15) |>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))


data_images_choosen_15_first <- data_images_comparison_15 |>
  dplyr::filter(abs(avg_diff)<15)|>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))


kable(data_images_comparison_15, caption = "Difference of means with a cutoff of 15 points")
Difference of means with a cutoff of 15 points
image task_Arab task_Jewish avg_diff rated_ethnicity
CFD_M-220-N.png 26.86364 26.90 0.0363636 Ambiguous
CFD_M-242-N.png 21.63636 21.90 0.2636364 Ambiguous
IFD_M-018-N.png 48.40909 47.60 0.8090909 Ambiguous
IFD_M-416-N.png 55.77273 54.95 0.8227273 Ambiguous
CFD_M-236-N.png 45.09091 43.70 1.3909091 Ambiguous
CFD_M-227-N.png 26.81818 28.60 1.7818182 Ambiguous
CFD_M-211-N.png 29.18182 31.05 1.8681818 Ambiguous
IFD_M-419-N.png 52.04545 54.00 1.9545455 Ambiguous
IFD_M-135-N.png 52.00000 55.30 3.3000000 Ambiguous
CFD_M-206-N.png 29.72727 25.90 3.8272727 Ambiguous
CFD_M-225-N.png 22.77273 18.50 4.2727273 Ambiguous
CFD_M-224-N.png 36.95455 41.30 4.3454545 Ambiguous
CFD_M-218-N.png 32.59091 27.95 4.6409091 Ambiguous
CFD_M-212-N.png 24.81818 29.80 4.9818182 Ambiguous
CFD_M-243-N.png 30.40909 25.35 5.0590909 Ambiguous
CFD_M-216-N.png 22.45455 16.25 6.2045455 Ambiguous
CFD_M-213-N.png 34.36364 28.00 6.3636364 Ambiguous
IFD_M-067-N.png 40.95455 34.50 6.4545455 Ambiguous
CFD_M-223-N.png 30.36364 23.80 6.5636364 Ambiguous
CFD_M-248-N.png 20.59091 27.90 7.3090909 Ambiguous
CFD_M-229-N.png 29.59091 22.10 7.4909091 Ambiguous
IFD_M-105-N.png 44.00000 53.55 9.5500000 Ambiguous
CFD_M-237-N.png 43.54545 33.85 9.6954545 Ambiguous
IFD_M-424-N.png 45.00000 34.65 10.3500000 Ambiguous
CFD_M-234-N.png 18.54545 28.95 10.4045455 Ambiguous
IFD_M-086-N.png 30.72727 41.35 10.6227273 Ambiguous
CFD_M-214-N.png 15.90909 27.00 11.0909091 Ambiguous
CFD_M-251-N.png 25.54545 36.90 11.3545455 Ambiguous
IFD_M-108-N.png 56.59091 45.05 11.5409091 Ambiguous
IFD_M-418-N.png 43.50000 55.35 11.8500000 Ambiguous
CFD_M-247-N.png 31.40909 19.50 11.9090909 Ambiguous
IFD_M-117-N.png 35.36364 47.35 11.9863636 Ambiguous
CFD_M-210-N.png 41.95455 27.75 14.2045455 Ambiguous
IFD_M-421-N.png 45.09091 59.30 14.2090909 Ambiguous
IFD_M-075-N.png 57.09091 41.90 15.1909091 Arab
IFD_M-121-N.png 37.72727 53.30 15.5727273 Jewish
CFD_M-204-N.png 36.04545 52.15 16.1045455 Jewish
IFD_M-132-N.png 46.31818 62.55 16.2318182 Jewish
CFD_M-222-N.png 17.40909 33.80 16.3909091 Jewish
CFD_M-200-N.png 19.40909 35.90 16.4909091 Jewish
CFD_M-253-N.png 21.22727 38.10 16.8727273 Jewish
IFD_M-051-N.png 57.09091 39.75 17.3409091 Arab
CFD_M-221-N.png 23.81818 41.75 17.9318182 Jewish
CFD_M-246-N.png 43.45455 24.30 19.1545455 Arab
CFD_M-231-N.png 19.77273 39.00 19.2272727 Jewish
IFD_M-136-N.png 63.40909 44.05 19.3590909 Arab
IFD_M-033-N.png 42.90909 62.35 19.4409091 Jewish
IFD_M-062-N.png 67.90909 47.35 20.5590909 Arab
CFD_M-230-N.png 54.81818 34.15 20.6681818 Arab
IFD_M-420-N.png 49.31818 27.80 21.5181818 Arab
IFD_M-111-N.png 66.77273 45.05 21.7227273 Arab
IFD_M-042-N.png 62.68182 40.80 21.8818182 Arab
IFD_M-122-N.png 40.81818 62.90 22.0818182 Jewish
IFD_M-100-N.png 41.54545 64.25 22.7045455 Jewish
IFD_M-084-N.png 60.36364 37.60 22.7636364 Arab
IFD_M-087-N.png 32.77273 55.55 22.7772727 Jewish
CFD_M-239-N.png 48.81818 25.70 23.1181818 Arab
IFD_M-044-N.png 60.00000 35.75 24.2500000 Arab
CFD_M-235-N.png 50.86364 26.25 24.6136364 Arab
IFD_M-015-N.png 32.77273 57.50 24.7272727 Jewish
IFD_M-097-N.png 65.09091 39.50 25.5909091 Arab
IFD_M-036-N.png 36.09091 62.50 26.4090909 Jewish
IFD_M-021-N.png 36.95455 64.65 27.6954545 Jewish
IFD_M-113-N.png 24.59091 52.85 28.2590909 Jewish
CFD_M-232-N.png 51.00000 21.95 29.0500000 Arab
IFD_M-441-N.png 28.72727 57.95 29.2227273 Jewish
IFD_M-032-N.png 64.13636 34.70 29.4363636 Arab
IFD_M-035-N.png 35.00000 65.50 30.5000000 Jewish
CFD_M-250-N.png 17.77273 48.45 30.6772727 Jewish
CFD_M-252-N.png 58.31818 27.30 31.0181818 Arab
IFD_M-114-N.png 23.31818 54.40 31.0818182 Jewish
IFD_M-049-N.png 73.59091 41.25 32.3409091 Arab
CFD_M-238-N.png 53.22727 19.95 33.2772727 Arab
IFD_M-020-N.png 65.81818 31.25 34.5681818 Arab
IFD_M-017-N.png 28.18182 64.75 36.5681818 Jewish
CFD_M-201-N.png 22.81818 62.95 40.1318182 Jewish
IFD_M-069-N.png 68.45455 27.50 40.9545455 Arab
IFD_M-423-N.png 68.22727 25.20 43.0272727 Arab
IFD_M-028-N.png 21.45455 65.05 43.5954545 Jewish
CFD_M-202-N.png 68.72727 15.35 53.3772727 Arab
IFD_M-066-N.png 85.40909 31.15 54.2590909 Arab
IFD_M-107-N.png 74.63636 19.95 54.6863636 Arab
IFD_M-045-N.png 84.95455 25.90 59.0545455 Arab
IFD_M-039-N.png 79.86364 18.00 61.8636364 Arab
IFD_M-046-N.png 84.31818 15.20 69.1181818 Arab
Code
saveRDS(data_images_15, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")

Summary Table:

Code
summary_table_15 <- data_images_comparison_15 |>
  count(rated_ethnicity) |>
  spread(key = rated_ethnicity, value = n)

# Print the summary table
kable(summary_table_15, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")
Summary of Rated Ethnicity
Ambiguous Arab Jewish
34 28 23

Comparing rating when taking into account all conditions VS only the first display:

Lets compare between the images when calculating the ratings based on all conditions VS when calculating only the firs retings:

Code
ambiguous_images_comparison_15 <- merge(data_images_15, data_images_comparison_15, by = "image", suffixes = c("_all", "_first"))

# Extracting 'Ambiguous' images from both datasets
ambiguous_images_all_15 = filter(data_images_15, rated_ethnicity == "Ambiguous")$image
ambiguous_images_first_15 = filter(data_images_comparison_15, rated_ethnicity == "Ambiguous")$image

# Finding common 'Ambiguous' images in both datasets
common_ambiguous_images_15 = intersect(ambiguous_images_all_15, ambiguous_images_first_15)

# Finding 'Ambiguous' images unique to the all conditions dataset
unique_ambiguous_all_15 = setdiff(ambiguous_images_all_15, ambiguous_images_first_15)

# Finding 'Ambiguous' images unique to the first ratings dataset
unique_ambiguous_first_15 = setdiff(ambiguous_images_first_15, ambiguous_images_all_15)

# Creating a summary table
summary_comparison_15 <- tibble(
  Common_Ambiguous_15 = length(common_ambiguous_images_15),
  Unique_Ambiguous_All_15 = length(unique_ambiguous_all_15),
  Unique_Ambiguous_First_15 = length(unique_ambiguous_first_15)
)

# Display the summary
knitr::kable(summary_comparison_15, 
             caption = "Comparison of Ambiguous Images Across Different Conditions 15",
             align = 'c')
Comparison of Ambiguous Images Across Different Conditions 15
Common_Ambiguous_15 Unique_Ambiguous_All_15 Unique_Ambiguous_First_15
30 5 4

Now let’s see the images id:

Code
common_ambiguous_images_df_15 <- tibble(Image = common_ambiguous_images_15, Category = "Common Ambiguous")
unique_ambiguous_all_df_15 <- tibble(Image = unique_ambiguous_all_15, Category = "Unique Ambiguous All")
unique_ambiguous_first_df_15 <- tibble(Image = unique_ambiguous_first_15, Category = "Unique Ambiguous First")

ambiguous_images_comparison_df_15 <- bind_rows(common_ambiguous_images_df_15, unique_ambiguous_all_df_15, unique_ambiguous_first_df_15)

# Display the comprehensive comparison
knitr::kable(ambiguous_images_comparison_df_15, 
             caption = "Comparison of Ambiguous Images Between All Conditions and First Ratings 15",
             align = 'c')
Comparison of Ambiguous Images Between All Conditions and First Ratings 15
Image Category
CFD_M-242-N.png Common Ambiguous
CFD_M-212-N.png Common Ambiguous
IFD_M-419-N.png Common Ambiguous
CFD_M-236-N.png Common Ambiguous
CFD_M-220-N.png Common Ambiguous
CFD_M-234-N.png Common Ambiguous
CFD_M-206-N.png Common Ambiguous
IFD_M-018-N.png Common Ambiguous
CFD_M-227-N.png Common Ambiguous
CFD_M-224-N.png Common Ambiguous
CFD_M-218-N.png Common Ambiguous
CFD_M-211-N.png Common Ambiguous
IFD_M-108-N.png Common Ambiguous
CFD_M-214-N.png Common Ambiguous
IFD_M-135-N.png Common Ambiguous
IFD_M-416-N.png Common Ambiguous
IFD_M-105-N.png Common Ambiguous
CFD_M-237-N.png Common Ambiguous
CFD_M-216-N.png Common Ambiguous
CFD_M-248-N.png Common Ambiguous
CFD_M-243-N.png Common Ambiguous
CFD_M-229-N.png Common Ambiguous
IFD_M-086-N.png Common Ambiguous
CFD_M-247-N.png Common Ambiguous
IFD_M-067-N.png Common Ambiguous
IFD_M-424-N.png Common Ambiguous
CFD_M-225-N.png Common Ambiguous
IFD_M-421-N.png Common Ambiguous
CFD_M-213-N.png Common Ambiguous
IFD_M-117-N.png Common Ambiguous
CFD_M-253-N.png Unique Ambiguous All
IFD_M-132-N.png Unique Ambiguous All
IFD_M-136-N.png Unique Ambiguous All
IFD_M-420-N.png Unique Ambiguous All
CFD_M-231-N.png Unique Ambiguous All
CFD_M-223-N.png Unique Ambiguous First
CFD_M-251-N.png Unique Ambiguous First
IFD_M-418-N.png Unique Ambiguous First
CFD_M-210-N.png Unique Ambiguous First

Difference of means per image by display with a cutoff of 20 points difference between the ratings

Code
data_images_comparison_20 <- data_participants_first_only |>
  group_by(image, display) |>
  summarize(average_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
  spread(key = display, value = average_rating) |>
  mutate(avg_diff = `task_Jewish` - `task_Arab`) |>
  mutate(rated_ethnicity = case_when(
    avg_diff < -20 ~ "Arab",
    avg_diff > 20 ~ "Jewish",
    TRUE ~ "Ambiguous"
  )) |>
  mutate(avg_diff = abs(avg_diff)) |>
  arrange(avg_diff)
  


data_images_big_diff_20_first <- data_images_comparison_20 |>
  dplyr::filter(abs(avg_diff) >= 20) |>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))


data_images_choosen_20_first <- data_images_comparison_20 |>
  dplyr::filter(abs(avg_diff)<20)|>
  mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
                                     avg_diff > 0 ~ "Jewish",
                                     .default = NA))



kable(data_images_comparison_20, caption = "Difference of means with a cutoff of 20 points")
Difference of means with a cutoff of 20 points
image task_Arab task_Jewish avg_diff rated_ethnicity
CFD_M-220-N.png 26.86364 26.90 0.0363636 Ambiguous
CFD_M-242-N.png 21.63636 21.90 0.2636364 Ambiguous
IFD_M-018-N.png 48.40909 47.60 0.8090909 Ambiguous
IFD_M-416-N.png 55.77273 54.95 0.8227273 Ambiguous
CFD_M-236-N.png 45.09091 43.70 1.3909091 Ambiguous
CFD_M-227-N.png 26.81818 28.60 1.7818182 Ambiguous
CFD_M-211-N.png 29.18182 31.05 1.8681818 Ambiguous
IFD_M-419-N.png 52.04545 54.00 1.9545455 Ambiguous
IFD_M-135-N.png 52.00000 55.30 3.3000000 Ambiguous
CFD_M-206-N.png 29.72727 25.90 3.8272727 Ambiguous
CFD_M-225-N.png 22.77273 18.50 4.2727273 Ambiguous
CFD_M-224-N.png 36.95455 41.30 4.3454545 Ambiguous
CFD_M-218-N.png 32.59091 27.95 4.6409091 Ambiguous
CFD_M-212-N.png 24.81818 29.80 4.9818182 Ambiguous
CFD_M-243-N.png 30.40909 25.35 5.0590909 Ambiguous
CFD_M-216-N.png 22.45455 16.25 6.2045455 Ambiguous
CFD_M-213-N.png 34.36364 28.00 6.3636364 Ambiguous
IFD_M-067-N.png 40.95455 34.50 6.4545455 Ambiguous
CFD_M-223-N.png 30.36364 23.80 6.5636364 Ambiguous
CFD_M-248-N.png 20.59091 27.90 7.3090909 Ambiguous
CFD_M-229-N.png 29.59091 22.10 7.4909091 Ambiguous
IFD_M-105-N.png 44.00000 53.55 9.5500000 Ambiguous
CFD_M-237-N.png 43.54545 33.85 9.6954545 Ambiguous
IFD_M-424-N.png 45.00000 34.65 10.3500000 Ambiguous
CFD_M-234-N.png 18.54545 28.95 10.4045455 Ambiguous
IFD_M-086-N.png 30.72727 41.35 10.6227273 Ambiguous
CFD_M-214-N.png 15.90909 27.00 11.0909091 Ambiguous
CFD_M-251-N.png 25.54545 36.90 11.3545455 Ambiguous
IFD_M-108-N.png 56.59091 45.05 11.5409091 Ambiguous
IFD_M-418-N.png 43.50000 55.35 11.8500000 Ambiguous
CFD_M-247-N.png 31.40909 19.50 11.9090909 Ambiguous
IFD_M-117-N.png 35.36364 47.35 11.9863636 Ambiguous
CFD_M-210-N.png 41.95455 27.75 14.2045455 Ambiguous
IFD_M-421-N.png 45.09091 59.30 14.2090909 Ambiguous
IFD_M-075-N.png 57.09091 41.90 15.1909091 Ambiguous
IFD_M-121-N.png 37.72727 53.30 15.5727273 Ambiguous
CFD_M-204-N.png 36.04545 52.15 16.1045455 Ambiguous
IFD_M-132-N.png 46.31818 62.55 16.2318182 Ambiguous
CFD_M-222-N.png 17.40909 33.80 16.3909091 Ambiguous
CFD_M-200-N.png 19.40909 35.90 16.4909091 Ambiguous
CFD_M-253-N.png 21.22727 38.10 16.8727273 Ambiguous
IFD_M-051-N.png 57.09091 39.75 17.3409091 Ambiguous
CFD_M-221-N.png 23.81818 41.75 17.9318182 Ambiguous
CFD_M-246-N.png 43.45455 24.30 19.1545455 Ambiguous
CFD_M-231-N.png 19.77273 39.00 19.2272727 Ambiguous
IFD_M-136-N.png 63.40909 44.05 19.3590909 Ambiguous
IFD_M-033-N.png 42.90909 62.35 19.4409091 Ambiguous
IFD_M-062-N.png 67.90909 47.35 20.5590909 Arab
CFD_M-230-N.png 54.81818 34.15 20.6681818 Arab
IFD_M-420-N.png 49.31818 27.80 21.5181818 Arab
IFD_M-111-N.png 66.77273 45.05 21.7227273 Arab
IFD_M-042-N.png 62.68182 40.80 21.8818182 Arab
IFD_M-122-N.png 40.81818 62.90 22.0818182 Jewish
IFD_M-100-N.png 41.54545 64.25 22.7045455 Jewish
IFD_M-084-N.png 60.36364 37.60 22.7636364 Arab
IFD_M-087-N.png 32.77273 55.55 22.7772727 Jewish
CFD_M-239-N.png 48.81818 25.70 23.1181818 Arab
IFD_M-044-N.png 60.00000 35.75 24.2500000 Arab
CFD_M-235-N.png 50.86364 26.25 24.6136364 Arab
IFD_M-015-N.png 32.77273 57.50 24.7272727 Jewish
IFD_M-097-N.png 65.09091 39.50 25.5909091 Arab
IFD_M-036-N.png 36.09091 62.50 26.4090909 Jewish
IFD_M-021-N.png 36.95455 64.65 27.6954545 Jewish
IFD_M-113-N.png 24.59091 52.85 28.2590909 Jewish
CFD_M-232-N.png 51.00000 21.95 29.0500000 Arab
IFD_M-441-N.png 28.72727 57.95 29.2227273 Jewish
IFD_M-032-N.png 64.13636 34.70 29.4363636 Arab
IFD_M-035-N.png 35.00000 65.50 30.5000000 Jewish
CFD_M-250-N.png 17.77273 48.45 30.6772727 Jewish
CFD_M-252-N.png 58.31818 27.30 31.0181818 Arab
IFD_M-114-N.png 23.31818 54.40 31.0818182 Jewish
IFD_M-049-N.png 73.59091 41.25 32.3409091 Arab
CFD_M-238-N.png 53.22727 19.95 33.2772727 Arab
IFD_M-020-N.png 65.81818 31.25 34.5681818 Arab
IFD_M-017-N.png 28.18182 64.75 36.5681818 Jewish
CFD_M-201-N.png 22.81818 62.95 40.1318182 Jewish
IFD_M-069-N.png 68.45455 27.50 40.9545455 Arab
IFD_M-423-N.png 68.22727 25.20 43.0272727 Arab
IFD_M-028-N.png 21.45455 65.05 43.5954545 Jewish
CFD_M-202-N.png 68.72727 15.35 53.3772727 Arab
IFD_M-066-N.png 85.40909 31.15 54.2590909 Arab
IFD_M-107-N.png 74.63636 19.95 54.6863636 Arab
IFD_M-045-N.png 84.95455 25.90 59.0545455 Arab
IFD_M-039-N.png 79.86364 18.00 61.8636364 Arab
IFD_M-046-N.png 84.31818 15.20 69.1181818 Arab
Code
saveRDS(data_images_20, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")

Summary Table:

Code
summary_table_20 <- data_images_comparison_20 |>
  count(rated_ethnicity) |>
  spread(key = rated_ethnicity, value = n)

# Print the summary table
kable(summary_table_20, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")
Summary of Rated Ethnicity
Ambiguous Arab Jewish
47 24 14

Comparing rating when taking into account all conditions VS only the first display:

Lets compare between the images when calculating the ratings based on all conditions VS when calculating only the first ratings:

Code
ambiguous_images_comparison_20 <- merge(data_images_20, data_images_comparison_20, by = "image", suffixes = c("_all", "_first"))

# Extracting 'Ambiguous' images from both datasets
ambiguous_images_all_20 = filter(data_images_20, rated_ethnicity == "Ambiguous")$image
ambiguous_images_first_20 = filter(data_images_comparison_20, rated_ethnicity == "Ambiguous")$image

# Finding common 'Ambiguous' images in both datasets
common_ambiguous_images_20 = intersect(ambiguous_images_all_20, ambiguous_images_first_20)

# Finding 'Ambiguous' images unique to the all conditions dataset
unique_ambiguous_all_20 = setdiff(ambiguous_images_all_20, ambiguous_images_first_20)

# Finding 'Ambiguous' images unique to the first ratings dataset
unique_ambiguous_first_20 = setdiff(ambiguous_images_first_20, ambiguous_images_all_20)

# Creating a summary table
summary_comparison_20 <- tibble(
  Common_Ambiguous_20 = length(common_ambiguous_images_20),
  Unique_Ambiguous_All_20 = length(unique_ambiguous_all_20),
  Unique_Ambiguous_First_20 = length(unique_ambiguous_first_20)
)

# Display the summary
knitr::kable(summary_comparison_20, 
             caption = "Comparison of Ambiguous Images Across Different Conditions 20",
             align = 'c')
Comparison of Ambiguous Images Across Different Conditions 20
Common_Ambiguous_20 Unique_Ambiguous_All_20 Unique_Ambiguous_First_20
43 8 4

Now let’s see the images id:

Code
common_ambiguous_images_df_20 <- tibble(Image = common_ambiguous_images_20, Category = "Common Ambiguous")
unique_ambiguous_all_df_20 <- tibble(Image = unique_ambiguous_all_20, Category = "Unique Ambiguous All")
unique_ambiguous_first_df_20 <- tibble(Image = unique_ambiguous_first_20, Category = "Unique Ambiguous First")

ambiguous_images_comparison_df_20 <- bind_rows(common_ambiguous_images_df_20, unique_ambiguous_all_df_20, unique_ambiguous_first_df_20)

# Display the comprehensive comparison
knitr::kable(ambiguous_images_comparison_df_20, 
             caption = "Comparison of Ambiguous Images Between All Conditions and First Ratings 20",
             align = 'c')
Comparison of Ambiguous Images Between All Conditions and First Ratings 20
Image Category
CFD_M-242-N.png Common Ambiguous
CFD_M-212-N.png Common Ambiguous
IFD_M-419-N.png Common Ambiguous
CFD_M-236-N.png Common Ambiguous
CFD_M-220-N.png Common Ambiguous
CFD_M-234-N.png Common Ambiguous
CFD_M-206-N.png Common Ambiguous
IFD_M-018-N.png Common Ambiguous
CFD_M-227-N.png Common Ambiguous
CFD_M-224-N.png Common Ambiguous
CFD_M-218-N.png Common Ambiguous
CFD_M-211-N.png Common Ambiguous
IFD_M-108-N.png Common Ambiguous
CFD_M-214-N.png Common Ambiguous
IFD_M-135-N.png Common Ambiguous
IFD_M-416-N.png Common Ambiguous
IFD_M-105-N.png Common Ambiguous
CFD_M-237-N.png Common Ambiguous
CFD_M-216-N.png Common Ambiguous
CFD_M-248-N.png Common Ambiguous
CFD_M-243-N.png Common Ambiguous
CFD_M-229-N.png Common Ambiguous
IFD_M-086-N.png Common Ambiguous
CFD_M-247-N.png Common Ambiguous
IFD_M-067-N.png Common Ambiguous
CFD_M-253-N.png Common Ambiguous
IFD_M-424-N.png Common Ambiguous
CFD_M-225-N.png Common Ambiguous
IFD_M-132-N.png Common Ambiguous
IFD_M-421-N.png Common Ambiguous
IFD_M-136-N.png Common Ambiguous
CFD_M-213-N.png Common Ambiguous
IFD_M-117-N.png Common Ambiguous
CFD_M-231-N.png Common Ambiguous
CFD_M-222-N.png Common Ambiguous
CFD_M-223-N.png Common Ambiguous
CFD_M-246-N.png Common Ambiguous
IFD_M-075-N.png Common Ambiguous
IFD_M-121-N.png Common Ambiguous
CFD_M-204-N.png Common Ambiguous
CFD_M-251-N.png Common Ambiguous
CFD_M-200-N.png Common Ambiguous
CFD_M-221-N.png Common Ambiguous
IFD_M-420-N.png Unique Ambiguous All
IFD_M-062-N.png Unique Ambiguous All
CFD_M-230-N.png Unique Ambiguous All
IFD_M-036-N.png Unique Ambiguous All
IFD_M-100-N.png Unique Ambiguous All
IFD_M-042-N.png Unique Ambiguous All
IFD_M-122-N.png Unique Ambiguous All
IFD_M-044-N.png Unique Ambiguous All
IFD_M-418-N.png Unique Ambiguous First
CFD_M-210-N.png Unique Ambiguous First
IFD_M-051-N.png Unique Ambiguous First
IFD_M-033-N.png Unique Ambiguous First

Visualization with ggplot2:

Visual stimuli:

References

Bakker, Marjan, and Jelte M Wicherts. 2014. “Outlier Removal, Sum Scores, and the Inflation of the Type i Error Rate in Independent Samples t Tests: The Power of Alternatives and Recommendations.” Psychological Methods 19 (3): 409.